\ color 05.3.10 NAB

needs core-ext

: color-depth ( bits -- )
  0 sp@
  0. 2swap
  0.
  0.
  WinScreenModeSet >byte
  WinScreenMode throw 2drop ;

: grayscale ( -- )  2 color-depth ;

: monochrome ( -- )  1 color-depth ;

: >rgb ( r g b -- rgb. )
  swap >byte or swap ;

: rgb> ( rgb. -- r g b )
  swap dup 8 rshift swap 15 and ;

: gray ( gray -- rgb. )
  dup dup ;

: color>gray ( r g b -- gray )
  100 877 */  swap  100 170 */  +
  swap  100 334 */  + ;

: set-colors ( fore-rgb. back-rgb. -- )
  sp@ 0. 2swap 0. 2over 16 m+
  WinSetColors 2drop 2drop ;

: get-colors ( -- fore-rgb. back-rgb. )
  0. 0. sp@ 0. 2over 4 m+ 0.
  WinSetColors ;

: foreground ( rgb. -- )
  sp@ 2>r
  0. 0. 0. 2r> WinSetColors 2drop ;

: background ( rgb. -- )
  sp@ 2>r
  0. 2r> 0. 0. WinSetColors 2drop ;

: color: ( r g b "name" -- )
  >rgb 2constant ;

0 gray color: black
127 gray color: dark-gray
191 gray color: light-gray
255 gray color: white

\ Example:
\ grayscale
\ light-gray background
\ black foreground
